C---------------------------------------------------------
C    TOOLPACK/1    Release: 3.1
C---------------------------------------------------------
C
C  FAST POLISH
C               CONVERT A TOKEN STREAM/COMMENT STREAM TO SOURCE CODE
C               AS QUICKLY AS POSSIBLE, LEAVE OUT COMMENTS AND PUT NO
C               SPACES BETWEEN TOKENS. PLACE A SPACE AFTER ALL KEYWORDS.
C               TRY NOT TO BREAK TOKENS
C               IF POSSIBLE
C
        PROGRAM ISTFP
 
        INTEGER TKPATH(81),OUTPTH(81),PROMPT(17,3),
     +          BUFFER(1322), CMPATH(81), STRING(1322)
     +
        INTEGER TKNFD, CMTFD, OUTFD, STATUS, TYPE, LENGTH, DESC
 
        INTEGER GETARG, OPEN, CREATE, ZGTCMD, ZTKGTI
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
      SAVE
 
      DATA (PROMPT(I,1),I=1,15)/84,111,107,101,110,32,
     +                115,116,114,101,97,109,58,32,129/,
     +     (PROMPT(I,2),I=1,17)/67,111,109,109,101,110,116,32,
     +                115,116,114,101,97,109,58,32,129/,
     +     (PROMPT(I,3),I=1,14)/79,117,116,112,117,116,32,
     +                102,105,108,101,58,32,129/
 
      CALL ZINIT
 
      IF (GETARG(1,TKPATH,81).EQ.-100) THEN
          CALL ZPRMPT(PROMPT(1,1))
          STATUS=ZGTCMD(TKPATH,0)
      END IF
      IF (GETARG(2,CMPATH,81).EQ.-100) THEN
          CALL ZPRMPT(PROMPT(1,2))
          STATUS=ZGTCMD(CMPATH,0)
      END IF
      IF (GETARG(3,OUTPTH,81).EQ.-100) THEN
          CALL ZPRMPT(PROMPT(1,3))
          STATUS=ZGTCMD(OUTPTH,0)
      END IF
 
      TKNFD=OPEN(TKPATH,0)
      IF (TKNFD.EQ.-1) CALL ERROR('Can''t open token stream.')
      CMTFD=OPEN(CMPATH,0)
      IF (CMTFD.EQ.-1) CALL ERROR('Can''t open comment stream.')
      OUTFD=CREATE(OUTPTH,1)
      IF (OUTFD.EQ.-1) CALL ERROR('Can''t create output file.')
      DESC =  ZTKGTI(1, TKNFD, CMTFD)
 
      CALL OUTPUT(0, TYPE, BUFFER, OUTFD)
   20 CONTINUE
        CALL ZGETTK(TYPE, LENGTH, STRING, DESC, STATUS)
        IF(STATUS .EQ. -1) THEN
          CALL ERROR('[ISTFP Token Read Error].')
        ELSE IF(TYPE .EQ. TZEOF) THEN
          CALL OUTPUT(1, TYPE, BUFFER, OUTFD)
          GO TO 30
        ELSE IF(TYPE .EQ. TCMMNT) THEN
          GO TO 20
        ELSE
          CALL ZTOKTX(TYPE, LENGTH, STRING, BUFFER)
          CALL OUTPUT(1, TYPE, BUFFER, OUTFD)
        ENDIF
      GO TO 20
 
   30 CONTINUE
      CALL ZMESS('[ISTFP Normal Termination].',1)
      CALL ZQUIT(-2)
 
      END
C-------------------------------------------
C
      SUBROUTINE OUTPUT(OP, TYPE, BUF, FD)
 
      INTEGER OP, TYPE, FD, I, LENGTH
      INTEGER BUF(*)
      LOGICAL NEW
 
      INTEGER LINE(73), POINT
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
      SAVE
 
      IF(OP .EQ. 0) THEN
        NEW   = .TRUE.
        POINT = 1
        RETURN
 
 
      ELSE IF((TYPE .EQ. TZEOS) .OR. (TYPE .EQ. TZEOF)) THEN
        IF(POINT .GT. 1) THEN
          LINE(POINT) = 129
          CALL ZPTMES(LINE, FD)
          POINT = 1
        ENDIF
        NEW = .TRUE.
        RETURN
 
      ELSE
        IF(NEW) THEN
          IF(TYPE .EQ. TDCNST) THEN
            CALL SCOPY(BUF, 1, LINE, 1)
            DO 10 POINT = LENGTH(LINE) + 1, 6
   10       LINE(POINT) = 32
            POINT = 7
            NEW   = .FALSE.
            RETURN
          ELSE
            LINE(1) = 32
            LINE(2) = 32
            LINE(3) = 32
            LINE(4) = 32
            LINE(5) = 32
            LINE(6) = 32
            POINT   = 7
          ENDIF
          NEW = .FALSE.
 
        ELSE
          IF(POINT .EQ. 1) THEN
            LINE(1) = 32
            LINE(2) = 32
            LINE(3) = 32
            LINE(4) = 32
            LINE(5) = 32
            LINE(6) = 43
            POINT   = 7
          ENDIF
 
        ENDIF
        IF((POINT + LENGTH(BUF) .GT. 73) .AND.
     +     (LENGTH(BUF) .LT. 66)) THEN
          LINE(POINT) = 129
          CALL ZPTMES(LINE, FD)
          POINT = 1
        ENDIF
 
        DO 20 I = 1, LENGTH(BUF)
          IF(POINT .EQ. 73) THEN
            POINT = 1
            LINE(73) = 129
            CALL ZPTMES(LINE, FD)
          ENDIF
          IF(POINT .EQ. 1) THEN
            LINE(1) = 32
            LINE(2) = 32
            LINE(3) = 32
            LINE(4) = 32
            LINE(5) = 32
            LINE(6) = 43
            POINT   = 7
          ENDIF
          LINE(POINT) = BUF(I)
          POINT = POINT + 1
   20   CONTINUE
 
      ENDIF
 
      END
